home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / nndoc.el.z / nndoc.el
Encoding:
Text File  |  1998-05-21  |  19.8 KB  |  629 lines
  1. ;;; nndoc.el --- single file access for Gnus
  2. ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  6. ;; Keywords: news
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;;; Code:
  28.  
  29. (require 'nnheader)
  30. (require 'message)
  31. (require 'nnmail)
  32. (require 'nnoo)
  33. (eval-when-compile (require 'cl))
  34.  
  35. (nnoo-declare nndoc)
  36.  
  37. (defvoo nndoc-article-type 'guess
  38.   "*Type of the file.
  39. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
  40. `rfc934', `rfc822-forward', `mime-digest', `standard-digest',
  41. `slack-digest', `clari-briefs' or `guess'.")
  42.  
  43. (defvoo nndoc-post-type 'mail
  44.   "*Whether the nndoc group is `mail' or `post'.")
  45.  
  46. (defvar nndoc-type-alist
  47.   `((mmdf
  48.      (article-begin .  "^\^A\^A\^A\^A\n")
  49.      (body-end .  "^\^A\^A\^A\^A\n"))
  50.     (news
  51.      (article-begin . "^Path:"))
  52.     (rnews
  53.      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
  54.      (body-end-function . nndoc-rnews-body-end))
  55.     (mbox
  56.      (article-begin-function . nndoc-mbox-article-begin)
  57.      (body-end-function . nndoc-mbox-body-end))
  58.     (babyl
  59.      (article-begin . "\^_\^L *\n")
  60.      (body-end . "\^_")
  61.      (body-begin-function . nndoc-babyl-body-begin)
  62.      (head-begin-function . nndoc-babyl-head-begin))
  63.     (forward
  64.      (article-begin . "^-+ Start of forwarded message -+\n+")
  65.      (body-end . "^-+ End of forwarded message -+$")
  66.      (prepare-body-function . nndoc-unquote-dashes))
  67.     (rfc934
  68.      (article-begin . "^--.*\n+")
  69.      (body-end . "^--.*$")
  70.      (prepare-body-function . nndoc-unquote-dashes))
  71.     (clari-briefs
  72.      (article-begin . "^ \\*")
  73.      (body-end . "^\t------*[ \t]^*\n^ \\*")
  74.      (body-begin . "^\t")
  75.      (head-end . "^\t")
  76.      (generate-head-function . nndoc-generate-clari-briefs-head)
  77.      (article-transform-function . nndoc-transform-clari-briefs))
  78.     (mime-digest
  79.      (article-begin . "")
  80.      (head-end . "^ ?$")
  81.      (body-end . "")
  82.      (file-end . "")
  83.      (subtype digest guess))
  84.     (standard-digest
  85.      (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
  86.      (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+"))
  87.      (prepare-body-function . nndoc-unquote-dashes)
  88.      (body-end-function . nndoc-digest-body-end)
  89.      (head-end . "^ ?$")
  90.      (body-begin . "^ ?\n")
  91.      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
  92.      (subtype digest guess))
  93.     (slack-digest
  94.      (article-begin . "^------------------------------*[\n \t]+")
  95.      (head-end . "^ ?$")
  96.      (body-end-function . nndoc-digest-body-end)
  97.      (body-begin . "^ ?$")
  98.      (file-end . "^End of")
  99.      (prepare-body-function . nndoc-unquote-dashes)
  100.      (subtype digest guess))
  101.     (lanl-gov-announce
  102.      (article-begin . "^\\\\\\\\\n")
  103.      (head-begin . "^Paper.*:")
  104.      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
  105.      (body-begin . "")
  106.      (body-end   . "-------------------------------------------------")
  107.      (file-end   . "^Title: Recent Seminal")
  108.      (generate-head-function . nndoc-generate-lanl-gov-head)
  109.      (article-transform-function . nndoc-transform-lanl-gov-announce)
  110.      (subtype preprints guess))
  111.     (rfc822-forward
  112.      (article-begin . "^\n")
  113.      (body-end-function . nndoc-rfc822-forward-body-end-function))
  114.     (guess
  115.      (guess . t)
  116.      (subtype nil))
  117.     (digest
  118.      (guess . t)
  119.      (subtype nil))
  120.     (preprints
  121.      (guess . t)
  122.      (subtype nil))))
  123.  
  124.  
  125.  
  126. (defvoo nndoc-file-begin nil)
  127. (defvoo nndoc-first-article nil)
  128. (defvoo nndoc-article-end nil)
  129. (defvoo nndoc-article-begin nil)
  130. (defvoo nndoc-head-begin nil)
  131. (defvoo nndoc-head-end nil)
  132. (defvoo nndoc-file-end nil)
  133. (defvoo nndoc-body-begin nil)
  134. (defvoo nndoc-body-end-function nil)
  135. (defvoo nndoc-body-begin-function nil)
  136. (defvoo nndoc-head-begin-function nil)
  137. (defvoo nndoc-body-end nil)
  138. (defvoo nndoc-dissection-alist nil)
  139. (defvoo nndoc-prepare-body-function nil)
  140. (defvoo nndoc-generate-head-function nil)
  141. (defvoo nndoc-article-transform-function nil)
  142. (defvoo nndoc-article-begin-function nil)
  143.  
  144. (defvoo nndoc-status-string "")
  145. (defvoo nndoc-group-alist nil)
  146. (defvoo nndoc-current-buffer nil
  147.   "Current nndoc news buffer.")
  148. (defvoo nndoc-address nil)
  149.  
  150. (defconst nndoc-version "nndoc 1.0"
  151.   "nndoc version.")
  152.  
  153.  
  154.  
  155. ;;; Interface functions
  156.  
  157. (nnoo-define-basics nndoc)
  158.  
  159. (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
  160.   (when (nndoc-possibly-change-buffer newsgroup server)
  161.     (save-excursion
  162.       (set-buffer nntp-server-buffer)
  163.       (erase-buffer)
  164.       (let (article entry)
  165.     (if (stringp (car articles))
  166.         'headers
  167.       (while articles
  168.         (when (setq entry (cdr (assq (setq article (pop articles))
  169.                      nndoc-dissection-alist)))
  170.           (insert (format "221 %d Article retrieved.\n" article))
  171.           (if nndoc-generate-head-function
  172.           (funcall nndoc-generate-head-function article)
  173.         (insert-buffer-substring
  174.          nndoc-current-buffer (car entry) (nth 1 entry)))
  175.           (goto-char (point-max))
  176.           (unless (= (char-after (1- (point))) ?\n)
  177.         (insert "\n"))
  178.           (insert (format "Lines: %d\n" (nth 4 entry)))
  179.           (insert ".\n")))
  180.  
  181.       (nnheader-fold-continuation-lines)
  182.       'headers)))))
  183.  
  184. (deffoo nndoc-request-article (article &optional newsgroup server buffer)
  185.   (nndoc-possibly-change-buffer newsgroup server)
  186.   (save-excursion
  187.     (let ((buffer (or buffer nntp-server-buffer))
  188.       (entry (cdr (assq article nndoc-dissection-alist)))
  189.       beg)
  190.       (set-buffer buffer)
  191.       (erase-buffer)
  192.       (when entry
  193.     (if (stringp article)
  194.         nil
  195.       (insert-buffer-substring
  196.        nndoc-current-buffer (car entry) (nth 1 entry))
  197.       (insert "\n")
  198.       (setq beg (point))
  199.       (insert-buffer-substring
  200.        nndoc-current-buffer (nth 2 entry) (nth 3 entry))
  201.       (goto-char beg)
  202.       (when nndoc-prepare-body-function
  203.         (funcall nndoc-prepare-body-function))
  204.       (when nndoc-article-transform-function
  205.         (funcall nndoc-article-transform-function article))
  206.       t)))))
  207.  
  208. (deffoo nndoc-request-group (group &optional server dont-check)
  209.   "Select news GROUP."
  210.   (let (number)
  211.     (cond
  212.      ((not (nndoc-possibly-change-buffer group server))
  213.       (nnheader-report 'nndoc "No such file or buffer: %s"
  214.                nndoc-address))
  215.      (dont-check
  216.       (nnheader-report 'nndoc "Selected group %s" group)
  217.       t)
  218.      ((zerop (setq number (length nndoc-dissection-alist)))
  219.       (nndoc-close-group group)
  220.       (nnheader-report 'nndoc "No articles in group %s" group))
  221.      (t
  222.       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
  223.  
  224. (deffoo nndoc-request-type (group &optional article)
  225.   (cond ((not article) 'unknown)
  226.         (nndoc-post-type nndoc-post-type)
  227.         (t 'unknown)))
  228.  
  229. (deffoo nndoc-close-group (group &optional server)
  230.   (nndoc-possibly-change-buffer group server)
  231.   (and nndoc-current-buffer
  232.        (buffer-name nndoc-current-buffer)
  233.        (kill-buffer nndoc-current-buffer))
  234.   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
  235.                 nndoc-group-alist))
  236.   (setq nndoc-current-buffer nil)
  237.   (nnoo-close-server 'nndoc server)
  238.   (setq nndoc-dissection-alist nil)
  239.   t)
  240.  
  241. (deffoo nndoc-request-list (&optional server)
  242.   nil)
  243.  
  244. (deffoo nndoc-request-newgroups (date &optional server)
  245.   nil)
  246.  
  247. (deffoo nndoc-request-list-newsgroups (&optional server)
  248.   nil)
  249.  
  250.  
  251. ;;; Internal functions.
  252.  
  253. (defun nndoc-possibly-change-buffer (group source)
  254.   (let (buf)
  255.     (cond
  256.      ;; The current buffer is this group's buffer.
  257.      ((and nndoc-current-buffer
  258.        (buffer-name nndoc-current-buffer)
  259.        (eq nndoc-current-buffer
  260.            (setq buf (cdr (assoc group nndoc-group-alist))))))
  261.      ;; We change buffers by taking an old from the group alist.
  262.      ;; `source' is either a string (a file name) or a buffer object.
  263.      (buf
  264.       (setq nndoc-current-buffer buf))
  265.      ;; It's a totally new group.
  266.      ((or (and (bufferp nndoc-address)
  267.            (buffer-name nndoc-address))
  268.       (and (stringp nndoc-address)
  269.            (file-exists-p nndoc-address)
  270.            (not (file-directory-p nndoc-address))))
  271.       (push (cons group (setq nndoc-current-buffer
  272.                   (get-buffer-create
  273.                    (concat " *nndoc " group "*"))))
  274.         nndoc-group-alist)
  275.       (setq nndoc-dissection-alist nil)
  276.       (save-excursion
  277.     (set-buffer nndoc-current-buffer)
  278.     (buffer-disable-undo (current-buffer))
  279.     (erase-buffer)
  280.     (if (stringp nndoc-address)
  281.         (nnheader-insert-file-contents nndoc-address)
  282.       (insert-buffer-substring nndoc-address)))))
  283.     ;; Initialize the nndoc structures according to this new document.
  284.     (when (and nndoc-current-buffer
  285.            (not nndoc-dissection-alist))
  286.       (save-excursion
  287.     (set-buffer nndoc-current-buffer)
  288.     (nndoc-set-delims)
  289.     (nndoc-dissect-buffer)))
  290.     (unless nndoc-current-buffer
  291.       (nndoc-close-server))
  292.     ;; Return whether we managed to select a file.
  293.     nndoc-current-buffer))
  294.  
  295. ;;;
  296. ;;; Deciding what document type we have
  297. ;;;
  298.  
  299. (defun nndoc-set-delims ()
  300.   "Set the nndoc delimiter variables according to the type of the document."
  301.   (let ((vars '(nndoc-file-begin
  302.         nndoc-first-article
  303.         nndoc-article-end nndoc-head-begin nndoc-head-end
  304.         nndoc-file-end nndoc-article-begin
  305.         nndoc-body-begin nndoc-body-end-function nndoc-body-end
  306.         nndoc-prepare-body-function nndoc-article-transform-function
  307.         nndoc-generate-head-function nndoc-body-begin-function
  308.         nndoc-head-begin-function)))
  309.     (while vars
  310.       (set (pop vars) nil)))
  311.   (let (defs)
  312.     ;; Guess away until we find the real file type.
  313.     (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
  314.                           nndoc-type-alist))))
  315.       (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
  316.     ;; Set the nndoc variables.
  317.     (while defs
  318.       (set (intern (format "nndoc-%s" (caar defs)))
  319.        (cdr (pop defs))))))
  320.  
  321. (defun nndoc-guess-type (subtype)
  322.   (let ((alist nndoc-type-alist)
  323.     results result entry)
  324.     (while (and (not result)
  325.         (setq entry (pop alist)))
  326.       (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
  327.     (goto-char (point-min))
  328.     (when (numberp (setq result (funcall (intern
  329.                           (format "nndoc-%s-type-p"
  330.                               (car entry))))))
  331.       (push (cons result entry) results)
  332.       (setq result nil))))
  333.     (unless (or result results)
  334.       (error "Document is not of any recognized type"))
  335.     (if result
  336.     (car entry)
  337.       (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
  338.  
  339. ;;;
  340. ;;; Built-in type predicates and functions
  341. ;;;
  342.  
  343. (defun nndoc-mbox-type-p ()
  344.   (when (looking-at message-unix-mail-delimiter)
  345.     t))
  346.  
  347. (defun nndoc-mbox-article-begin ()
  348.   (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
  349.     (goto-char (match-beginning 0))))
  350.  
  351. (defun nndoc-mbox-body-end ()
  352.   (let ((beg (point))
  353.     len end)
  354.     (when
  355.     (save-excursion
  356.       (and (re-search-backward
  357.         (concat "^" message-unix-mail-delimiter) nil t)
  358.            (setq end (point))
  359.            (search-forward "\n\n" beg t)
  360.            (re-search-backward
  361.         "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
  362.            (setq len (string-to-int (match-string 1)))
  363.            (search-forward "\n\n" beg t)
  364.            (unless (= (setq len (+ (point) len)) (point-max))
  365.          (and (< len (point-max))
  366.               (goto-char len)
  367.               (looking-at message-unix-mail-delimiter)))))
  368.       (goto-char len))))
  369.  
  370. (defun nndoc-mmdf-type-p ()
  371.   (when (looking-at "\^A\^A\^A\^A$")
  372.     t))
  373.  
  374. (defun nndoc-news-type-p ()
  375.   (when (looking-at "^Path:.*\n")
  376.     t))
  377.  
  378. (defun nndoc-rnews-type-p ()
  379.   (when (looking-at "#! *rnews")
  380.     t))
  381.  
  382. (defun nndoc-rnews-body-end ()
  383.   (and (re-search-backward nndoc-article-begin nil t)
  384.        (forward-line 1)
  385.        (goto-char (+ (point) (string-to-int (match-string 1))))))
  386.  
  387. (defun nndoc-babyl-type-p ()
  388.   (when (re-search-forward "\^_\^L *\n" nil t)
  389.     t))
  390.  
  391. (defun nndoc-babyl-body-begin ()
  392.   (re-search-forward "^\n" nil t)
  393.   (when (looking-at "\*\*\* EOOH \*\*\*")
  394.     (let ((next (or (save-excursion
  395.               (re-search-forward nndoc-article-begin nil t))
  396.             (point-max))))
  397.       (unless (re-search-forward "^\n" next t)
  398.     (goto-char next)
  399.     (forward-line -1)
  400.     (insert "\n")
  401.     (forward-line -1)))))
  402.  
  403. (defun nndoc-babyl-head-begin ()
  404.   (when (re-search-forward "^[0-9].*\n" nil t)
  405.     (when (looking-at "\*\*\* EOOH \*\*\*")
  406.       (forward-line 1))
  407.     t))
  408.  
  409. (defun nndoc-forward-type-p ()
  410.   (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
  411.          (not (re-search-forward "^Subject:.*digest" nil t))
  412.          (not (re-search-backward "^From:" nil t 2))
  413.          (not (re-search-forward "^From:" nil t 2)))
  414.     t))
  415.  
  416. (defun nndoc-rfc934-type-p ()
  417.   (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
  418.          (not (re-search-forward "^Subject:.*digest" nil t))
  419.          (not (re-search-backward "^From:" nil t 2))
  420.          (not (re-search-forward "^From:" nil t 2)))
  421.     t))
  422.  
  423. (defun nndoc-rfc822-forward-type-p ()
  424.   (save-restriction
  425.     (message-narrow-to-head)
  426.     (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
  427.       t)))
  428.  
  429. (defun nndoc-rfc822-forward-body-end-function ()
  430.   (goto-char (point-max)))
  431.  
  432. (defun nndoc-clari-briefs-type-p ()
  433.   (when (let ((case-fold-search nil))
  434.       (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
  435.     t))
  436.  
  437. (defun nndoc-transform-clari-briefs (article)
  438.   (goto-char (point-min))
  439.   (when (looking-at " *\\*\\(.*\\)\n")
  440.     (replace-match "" t t))
  441.   (nndoc-generate-clari-briefs-head article))
  442.  
  443. (defun nndoc-generate-clari-briefs-head (article)
  444.   (let ((entry (cdr (assq article nndoc-dissection-alist)))
  445.     subject from)
  446.     (save-excursion
  447.       (set-buffer nndoc-current-buffer)
  448.       (save-restriction
  449.     (narrow-to-region (car entry) (nth 3 entry))
  450.     (goto-char (point-min))
  451.     (when (looking-at " *\\*\\(.*\\)$")
  452.       (setq subject (match-string 1))
  453.       (when (string-match "[ \t]+$" subject)
  454.         (setq subject (substring subject 0 (match-beginning 0)))))
  455.     (when
  456.         (let ((case-fold-search nil))
  457.           (re-search-forward
  458.            "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
  459.       (setq from (match-string 1)))))
  460.     (insert "From: " "clari@clari.net (" (or from "unknown") ")"
  461.         "\nSubject: " (or subject "(no subject)") "\n")))
  462.  
  463. (defun nndoc-mime-digest-type-p ()
  464.   (let ((case-fold-search t)
  465.     boundary-id b-delimiter entry)
  466.     (when (and
  467.        (re-search-forward
  468.         (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
  469.             "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
  470.         nil t)
  471.        (match-beginning 1))
  472.       (setq boundary-id (match-string 1)
  473.         b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
  474.       (setq entry (assq 'mime-digest nndoc-type-alist))
  475.       (setcdr entry
  476.           (list
  477.            (cons 'head-end "^ ?$")
  478.            (cons 'body-begin "^ ?\n")
  479.            (cons 'article-begin b-delimiter)
  480.            (cons 'body-end-function 'nndoc-digest-body-end)
  481.            (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
  482.       t)))
  483.  
  484. (defun nndoc-standard-digest-type-p ()
  485.   (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
  486.          (re-search-forward
  487.           (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
  488.     t))
  489.  
  490. (defun nndoc-digest-body-end ()
  491.   (and (re-search-forward nndoc-article-begin nil t)
  492.        (goto-char (match-beginning 0))))
  493.  
  494. (defun nndoc-slack-digest-type-p ()
  495.   0)
  496.  
  497. (defun nndoc-lanl-gov-announce-type-p ()
  498.   (when (let ((case-fold-search nil))
  499.       (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
  500.     t))
  501.  
  502. (defun nndoc-transform-lanl-gov-announce (article)
  503.   (goto-char (point-max))
  504.   (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
  505.     (replace-match "\n\nGet it at \\1 (\\2)" t nil))
  506.   ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
  507.   ;;    (replace-match "" t t))
  508.   )
  509.  
  510. (defun nndoc-generate-lanl-gov-head (article)
  511.   (let ((entry (cdr (assq article nndoc-dissection-alist)))
  512.      (e-mail "no address given")
  513.      subject from)
  514.     (save-excursion
  515.       (set-buffer nndoc-current-buffer)
  516.       (save-restriction
  517.      (narrow-to-region (car entry) (nth 1 entry))
  518.      (goto-char (point-min))
  519.      (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
  520.        (setq subject (concat " (" (match-string 1) ")"))
  521.        (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
  522.          (setq e-mail (match-string 1)))
  523.        (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
  524.                     nil t)
  525.          (setq subject (concat (match-string 1) subject))
  526.          (setq from (concat (match-string 2) " <" e-mail ">"))))
  527.      ))
  528.     (while (and from (string-match "(\[^)\]*)" from))
  529.       (setq from (replace-match "" t t from)))
  530.     (insert "From: "  (or from "unknown")
  531.          "\nSubject: " (or subject "(no subject)") "\n")))
  532.  
  533.  
  534.  
  535. ;;;
  536. ;;; Functions for dissecting the documents
  537. ;;;
  538.  
  539. (defun nndoc-search (regexp)
  540.   (prog1
  541.       (re-search-forward regexp nil t)
  542.     (beginning-of-line)))
  543.  
  544. (defun nndoc-dissect-buffer ()
  545.   "Go through the document and partition it into heads/bodies/articles."
  546.   (let ((i 0)
  547.     (first t)
  548.     head-begin head-end body-begin body-end)
  549.     (setq nndoc-dissection-alist nil)
  550.     (save-excursion
  551.       (set-buffer nndoc-current-buffer)
  552.       (goto-char (point-min))
  553.       ;; Find the beginning of the file.
  554.       (when nndoc-file-begin
  555.     (nndoc-search nndoc-file-begin))
  556.       ;; Go through the file.
  557.       (while (if (and first nndoc-first-article)
  558.          (nndoc-search nndoc-first-article)
  559.            (nndoc-article-begin))
  560.     (setq first nil)
  561.     (cond (nndoc-head-begin-function
  562.            (funcall nndoc-head-begin-function))
  563.           (nndoc-head-begin
  564.            (nndoc-search nndoc-head-begin)))
  565.      (if (or (>= (point) (point-max))
  566.         (and nndoc-file-end
  567.              (looking-at nndoc-file-end)))
  568.         (goto-char (point-max))
  569.       (setq head-begin (point))
  570.       (nndoc-search (or nndoc-head-end "^$"))
  571.       (setq head-end (point))
  572.       (if nndoc-body-begin-function
  573.           (funcall nndoc-body-begin-function)
  574.         (nndoc-search (or nndoc-body-begin "^\n")))
  575.       (setq body-begin (point))
  576.       (or (and nndoc-body-end-function
  577.            (funcall nndoc-body-end-function))
  578.           (and nndoc-body-end
  579.            (nndoc-search nndoc-body-end))
  580.           (nndoc-article-begin)
  581.           (progn
  582.         (goto-char (point-max))
  583.         (when nndoc-file-end
  584.           (and (re-search-backward nndoc-file-end nil t)
  585.                (beginning-of-line)))))
  586.       (setq body-end (point))
  587.       (push (list (incf i) head-begin head-end body-begin body-end
  588.               (count-lines body-begin body-end))
  589.         nndoc-dissection-alist))))))
  590.  
  591. (defun nndoc-article-begin ()
  592.   (if nndoc-article-begin-function
  593.       (funcall nndoc-article-begin-function)
  594.     (ignore-errors
  595.       (nndoc-search nndoc-article-begin))))
  596.  
  597. (defun nndoc-unquote-dashes ()
  598.   "Unquote quoted non-separators in digests."
  599.   (while (re-search-forward "^- -"nil t)
  600.     (replace-match "-" t t)))
  601.  
  602. ;;;###autoload
  603. (defun nndoc-add-type (definition &optional position)
  604.   "Add document DEFINITION to the list of nndoc document definitions.
  605. If POSITION is nil or `last', the definition will be added
  606. as the last checked definition, if t or `first', add as the
  607. first definition, and if any other symbol, add after that
  608. symbol in the alist."
  609.   ;; First remove any old instances.
  610.   (setq nndoc-type-alist
  611.     (delq (assq (car definition) nndoc-type-alist)
  612.           nndoc-type-alist))
  613.   ;; Then enter the new definition in the proper place.
  614.   (cond
  615.    ((or (null position) (eq position 'last))
  616.     (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
  617.    ((or (eq position t) (eq position 'first))
  618.     (push definition nndoc-type-alist))
  619.    (t
  620.     (let ((list (memq (assq position nndoc-type-alist)
  621.               nndoc-type-alist)))
  622.       (unless list
  623.     (error "No such position: %s" position))
  624.       (setcdr list (cons definition (cdr list)))))))
  625.  
  626. (provide 'nndoc)
  627.  
  628. ;;; nndoc.el ends here
  629.